library(data.table)
library(ggplot2)
library(magrittr)
library(extrafont)
library(scales)
library(fBasics)
library(tseries)
library(plot3D)
library(reshape2)
library(gridExtra)

source('setup.R')

01 - Summaries

Number of Daily Observations

termSt[, cNObsSum, with=FALSE] %>%
  melt(id.vars=1, measure.vars = 2:ncol(.)) %>%
  ggplot(aes(x = timestamp, y = value)) +
    geom_line(size=0.3) +
    facet_grid(variable~.) +
    scale_x_date(breaks=pretty_breaks(10)) +
    labs(
      title='Number of Daily Observations',
      subtitle='of Interest Rate Futures Prices',
      x='date',
      y='number of observations'
    ) +
    thesisPlotTheme

Closing Prices of Interest Rate Futures

termSt[, cCloseLobs, with=FALSE] %>%
  melt(id.vars=1, measure.vars = 2:ncol(.)) %>%
  ggplot(aes(x = timestamp, y = value)) +
    geom_line(size=0.3) +
    facet_grid(variable~.) +
    scale_x_date(breaks=pretty_breaks(10)) +
    labs(
      title='Closing Prices',
      subtitle='of interest rate futures',
      x='date',
      y='closing price'
    ) +
    thesisPlotTheme

Summary Statistics

termSt[, cCloseLobs[-1], with=FALSE] %>%
  basicStats() %>%
  subset(rownames(.) %in% thesisRequiredSats)
TU_close_lobs FV_close_lobs TY_close_lobs US_close_lobs
nobs 6837.000000 6837.000000 6837.000000 6837.000000
Minimum 98.234375 96.546875 94.000000 89.218750
Maximum 110.398438 124.921875 135.250000 165.812500
1. Quartile 103.218750 105.750000 107.156250 107.187500
3. Quartile 108.687500 116.578125 119.250000 122.890625
Mean 105.616607 110.959653 113.567181 117.133559
Median 105.303125 109.796875 112.218750 114.000000
Variance 9.650784 45.802853 83.367837 221.332943
Stdev 3.106571 6.767781 9.130599 14.877263
Skewness -0.041553 0.288544 0.410090 0.908358
Kurtosis -1.057277 -0.804357 -0.525422 0.390829

Yields of Interest Rate Futures

termSt[, cYieldLobs, with=FALSE] %>%
  melt(id.vars=1, measure.vars = 2:ncol(.)) %>%
  ggplot(aes(x = timestamp, y = value)) +
    geom_line(size=0.3) +
    facet_grid(variable~.) +
    scale_x_date(breaks=pretty_breaks(10)) +
    labs(
      title='Yields',
      subtitle='of interest rate futures',
      x='date',
      y='yield'
    ) +
    thesisPlotTheme

Summary Statistics

termSt[, cYieldLobs[-1], with=FALSE] %>%
  basicStats() %>%
  subset(rownames(.) %in% thesisRequiredSats)
TU_yield_lobs FV_yield_lobs TY_yield_lobs US_yield_lobs
nobs 6837.000000 6837.000000 6837.000000 6837.000000
Minimum 0.009694 0.014720 0.029340 0.039658
Maximum 0.070384 0.068381 0.067480 0.065753
1. Quartile 0.017610 0.028846 0.042382 0.052190
3. Quartile 0.044220 0.049102 0.053588 0.057960
Mean 0.032634 0.039520 0.047851 0.054546
Median 0.033834 0.041252 0.048736 0.055356
Variance 0.000232 0.000159 0.000069 0.000026
Stdev 0.015216 0.012596 0.008330 0.005140
Skewness 0.105866 -0.163604 -0.233395 -0.610595
Kurtosis -0.991157 -0.800567 -0.565503 -0.052241

Neslon-Siegel Model Fit

rowSubset <- seq.int(1L, nrow(termSt), by=25L)
plotData <- data.frame()
for(i in 1:length(rowSubset)){
  obs <- termSt[rowSubset[i], cBetaLobs, with=FALSE]
  ts <- obs[[1]]
  betas <- unlist(obs[, 2:4])
  plotData <- rbind(plotData, fitYields(betas, ts))
}
acast(plotData, date ~ maturity, value.var='yield') %>%
  persp3D(z=., y=as.numeric(colnames(.)), x=seq(from=0, to=90, along.with=rownames(.)),
          main='Fitted Yield Curves', xlab='time', ylab='maturity', zlab='yield',
          ticktype='simple', theta=35, phi=25, facets=FALSE, col='black', expand=550, d=25,
          scale=FALSE, bty='u', lwd=0.25)

plotData <- data.table()

set.seed(100)
randomObs <- sample(1:nrow(termSt), size = 16)

for(o in randomObs){
  oDate <- termSt[o, timestamp]
  
  betas <- termSt[o, cBetaLobs[-1], with=FALSE]
  fittedYields <- fitYields(betas, oDate)
  
  observedYields <- data.frame(
    maturity=c(2, 5, 10, 25),
    yield=as.vector(t(termSt[o, cYieldLobs[-1], with=FALSE])),
    type='observed',
    date=oDate
  )
  
  plotData <- rbind(plotData, fittedYields, observedYields)
}

plotData %>%
  ggplot(aes(x=maturity, y=yield)) +
    geom_point(data=plotData[type=='observed', ], aes(shape=type), size=1) +
    geom_line(data=plotData[type=='fitted', ], aes(lty=type), size=0.25) +
    facet_wrap(~ date) +
    labs(
      title='Fitted vs. the Observed Yield Curve',
      subtitle='using the Dynamic Nelson Siegel Model',
      x='maturity',
      y='yield'
    ) +
    thesisPlotTheme

termSt[, .(timestamp,
           TU_yield_res = TU_yield_lobs - fitYield(ns_beta0_lobs, ns_beta1_lobs, ns_beta2_lobs, 2),
           FV_yield_res = FV_yield_lobs - fitYield(ns_beta0_lobs, ns_beta1_lobs, ns_beta2_lobs, 5),
           TY_yield_res = TY_yield_lobs - fitYield(ns_beta0_lobs, ns_beta1_lobs, ns_beta2_lobs, 10),
           US_yield_res = US_yield_lobs - fitYield(ns_beta0_lobs, ns_beta1_lobs, ns_beta2_lobs, 25))] %>%
  melt(id.vars=1, measure.vars = 2:ncol(.)) %>%
  ggplot(aes(x = timestamp, y = value)) +
    geom_line(size=0.3) +
    facet_grid(variable~.) +
    scale_x_date(breaks=pretty_breaks(10)) +
    labs(
      title='Residuals',
      subtitle='of yield estimates of the Dynamic Nelson Siegel Model',
      x='date',
      y='residual'
    ) +
    thesisPlotTheme

Realised Variances of Yields of Interest Rate Futures

termSt[, cYieldRV, with=FALSE] %>%
  melt(id.vars=1, measure.vars = 2:ncol(.)) %>%
  ggplot(aes(x = timestamp, y = value)) +
    geom_line(size=0.3) +
    facet_grid(variable~.) +
    scale_x_date(breaks=pretty_breaks(10)) +
    labs(
      title='Realised Variance',
      subtitle='of yields of interest rate futures',
      x='date',
      y='realised variance'
    ) +
    thesisPlotTheme

Summary Statistics

termSt[, cYieldRV[-1], with=FALSE] %>%
  basicStats() %>%
  subset(rownames(.) %in% thesisRequiredSats)
TU_yield_rv FV_yield_rv TY_yield_rv US_yield_rv
nobs 6837.000000 6837.000000 6837.000000 6837.000000
Minimum 0.000000 0.000000 0.000000 0.000000
Maximum 0.000019 0.000008 0.000007 0.000003
1. Quartile 0.000000 0.000000 0.000000 0.000000
3. Quartile 0.000000 0.000000 0.000000 0.000000
Mean 0.000000 0.000000 0.000000 0.000000
Median 0.000000 0.000000 0.000000 0.000000
Variance 0.000000 0.000000 0.000000 0.000000
Stdev 0.000001 0.000000 0.000000 0.000000
Skewness 13.322684 9.257132 12.529574 20.688364
Kurtosis 334.601799 150.137425 336.859838 910.608072

Beta Estimates of the Dynamic Nelson Siegel Model

termSt[, cBetaLobs, with=FALSE] %>%
  melt(id.vars=1, measure.vars = 2:ncol(.)) %>%
  ggplot(aes(x = timestamp, y = value)) +
    geom_line(size=0.3) +
    facet_grid(variable~.) +
    scale_x_date(breaks=pretty_breaks(10)) +
    labs(
      title='Coefficient Estimates',
      subtitle='of the Dynamic Nelson Siegel Model',
      x='date',
      y='coefficient estimate'
    ) +
    thesisPlotTheme

Summary Statistics

termSt[, cBetaLobs[-1], with=FALSE] %>%
  basicStats() %>%
  subset(rownames(.) %in% thesisRequiredSats)
ns_beta0_lobs ns_beta1_lobs ns_beta2_lobs
nobs 6837.000000 6837.000000 6837.000000
Minimum -0.093266 -0.033046 -0.053068
Maximum 0.086329 0.131252 0.303178
1. Quartile -0.029998 -0.001926 0.059367
3. Quartile 0.036576 0.043665 0.205272
Mean 0.006292 0.020226 0.128260
Median 0.008832 0.014289 0.126145
Variance 0.001391 0.000758 0.006585
Stdev 0.037301 0.027527 0.081151
Skewness 0.030937 0.235343 -0.122961
Kurtosis -1.259518 -0.978529 -1.247380

Augmented Dickey-Fuller Test

res <- data.table()
for(xCol in cBetaLobs[-1]){
  termSt[[xCol]] %>%
    adf.test() %>%
    unlist() %>%
    c(series=names(termSt)[xCol]) %>%
    t() %>%
    rbind(res) ->
    res
}
res[, .(series,
        adf_stat = `statistic.Dickey-Fuller`,
        lag_order = `parameter.Lag order`,
        p.value,
        alt = alternative)]
series adf_stat lag_order p.value alt
ns_beta2_lobs -2.23191978501948 18 0.480126381790165 stationary
ns_beta1_lobs -2.91177627329217 18 0.192162396452216 stationary
ns_beta0_lobs -2.33722055532135 18 0.43552457244019 stationary

First Differences of Beta Estimates of the Dynamic Nelson Siegel Model

termSt[, cBetaDiff, with=FALSE] %>%
  melt(id.vars=1, measure.vars = 2:ncol(.)) %>%
  ggplot(aes(x = timestamp, y = value)) +
    geom_line(size=0.3) +
    facet_grid(variable~.) +
    scale_x_date(breaks=pretty_breaks(10)) +
    labs(
      title='First Differences of Coefficient Estimates',
      subtitle='of the Dynamic Nelson Siegel Model',
      x='date',
      y='first difference of coefficient estimate'
    ) +
    thesisPlotTheme

Augmented Dickey-Fuller Test

res <- data.table()
for(xCol in cBetaDiff[-1]){
  termSt[[xCol]] %>%
    adf.test() %>%
    unlist() %>%
    c(series=names(termSt)[xCol]) %>%
    t() %>%
    rbind(res) ->
    res
}
res[, .(series,
        adf_stat = `statistic.Dickey-Fuller`,
        lag_order = `parameter.Lag order`,
        p.value,
        alt = alternative)]
series adf_stat lag_order p.value alt
ns_beta2_diff -19.4983134966771 18 0.01 stationary
ns_beta1_diff -20.0045239523471 18 0.01 stationary
ns_beta0_diff -19.8829634711764 18 0.01 stationary

Realised Variances of Beta Estimates of the DNSM

termSt[, cBetaRV, with=FALSE] %>%
  melt(id.vars=1, measure.vars = 2:ncol(.)) %>%
  ggplot(aes(x = timestamp, y = value)) +
    geom_line(size=0.3) +
    facet_grid(variable~.) +
    scale_x_date(breaks=pretty_breaks(10)) +
    labs(
      title='Realised Variance',
      subtitle='of coefficient estimates of the Dynamic Nelson Siegel Model',
      x='date',
      y='realised variance'
    ) +
    thesisPlotTheme

Summary Statistics

termSt[, cBetaRV[-1], with=FALSE] %>%
  basicStats() %>%
  subset(rownames(.) %in% thesisRequiredSats)
ns_beta0_rv ns_beta1_rv ns_beta2_rv
nobs 6837.000000 6837.000000 6837.000000
Minimum 0.000000 0.000000 0.000000
Maximum 0.001336 0.000947 0.004893
1. Quartile 0.000005 0.000005 0.000019
3. Quartile 0.000017 0.000014 0.000059
Mean 0.000014 0.000012 0.000049
Median 0.000009 0.000008 0.000032
Variance 0.000000 0.000000 0.000000
Stdev 0.000025 0.000019 0.000090
Skewness 27.393721 23.026294 28.610329
Kurtosis 1248.099604 944.663004 1330.000412